unit HintMngr;
{ Hecho por Gabriel Debia. Modificado por Diego Finochietto }

interface

uses
  Windows, Controls, Graphics, ExtCtrls, Forms, Classes, Messages;

type

 THintOrientation = (hoUpLeft, hoDownLeft, hoUpRight, hoDownRight);

 THintDrawWindow = class;

 TDrawHintEvent = procedure(Sender:THintDrawWindow; Canvas:TCanvas; const Caption:TCaption) of object;

 THintDrawWindow = class(THintWindow)
 private
   procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
 protected
   procedure Paint; override;
 public
   OnDrawHint : TDrawHintEvent;
 end;

 THintManager = class(TComponent)
 private
    FTimer : TTimer;
    FVisible : boolean;
    FHintWindow : THintDrawWindow;
    FPosition: TPoint;
    FOrientation : THintOrientation;
    FMaxShowTime: Integer;
    FMaxWidth: LongInt;
    procedure OnTimer(Sender: TObject);
    function GetCanvas: TCanvas;
    function GetCaption: TCaption;
    function GetColor: TColor;
    function GetFont: TFont;
    procedure SetCaption(const Value: TCaption);
    procedure SetColor(const Value: TColor);
    procedure SetFont(const Value: TFont);
    procedure SetPosition(const Value: TPoint);
    procedure SetVisible(const Value: Boolean);
    function GetRectangle: TRect;
    function GetPositionX: Longint;
    function GetPositionY: Longint;
    procedure SetPositionX(const Value: Longint);
    procedure SetPositionY(const Value: Longint);
    procedure SetOrientation(const Value: THintOrientation);
    function GetOnDrawHint: TDrawHintEvent;
    procedure SetOnDrawHint(const Value: TDrawHintEvent);
    procedure SetMaxShowTime(const Value: Integer);
    procedure Show;
    procedure Hide;
    procedure SetMaxWidth(const Value: LongInt);
 public
   property HintWindow : THintDrawWindow read FHintWindow;
   property Position : TPoint read FPosition write SetPosition;
   property Canvas: TCanvas read GetCanvas;
   function PositionFromControl(Control:TControl; Vertex: THintOrientation=hoUpLeft;
                                HorPercent:Integer=0; VerPercent:Integer=0): TPoint;
   procedure ShowHintFromControl(Control:TControl; Vertex: THintOrientation=hoUpLeft;
                                HorPercent:Integer=0; VerPercent:Integer=0);
   procedure ShowHint;
   procedure HideHint;
   procedure UpdateHint;
   constructor Create(AOwner:TComponent); override;
   destructor destroy; override;
 published
   property MaxShowTime : Integer read FMaxShowTime write SetMaxShowTime;
   property OnDrawHint : TDrawHintEvent read GetOnDrawHint write SetOnDrawHint;
   property PositionX : Longint read GetPositionX write SetPositionX;
   property PositionY : Longint read GetPositionY write SetPositionY;
   property Orientation : THintOrientation read FOrientation write SetOrientation;
   property Rectangle : TRect read GetRectangle;
   property MaxWidth : LongInt read FMaxWidth write SetMaxWidth;
   property Caption : TCaption read GetCaption write SetCaption;
   property Color : TColor read GetColor write SetColor;
   property Font:TFont read GetFont write SetFont;
   property Visible:Boolean read FVisible write SetVisible;
 end;

procedure Register;

implementation

{ THintManager }

constructor THintManager.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FMaxShowTime := 0;
  FTimer := TTimer.Create(nil);
  FTimer.Enabled := false;
  FTimer.OnTimer := OnTimer;
  FHintWindow := THintDrawWindow.Create(nil);
  FOrientation := hoUpRight;
  FPosition.X := Screen.DesktopWidth div 2;
  FPosition.Y := Screen.DesktopHeight div 2;
end;

destructor THintManager.destroy;
begin
  FTimer.Enabled := false;
  FTimer.Free;
  HintWindow.Free;
  inherited;
end;

function THintManager.GetCanvas: TCanvas;
begin
  result := HintWindow.Canvas;
end;

function THintManager.GetCaption: TCaption;
begin
  result := HintWindow.Caption;
end;

function THintManager.GetColor: TColor;
begin
  result := HintWindow.Color;
end;

function THintManager.GetFont: TFont;
begin
  result := HintWindow.Font;
end;

procedure THintManager.SetCaption(const Value: TCaption);
begin
  HintWindow.Caption := Value;
end;

procedure THintManager.SetColor(const Value: TColor);
begin
  HintWindow.Color := Value;
end;

procedure THintManager.SetFont(const Value: TFont);
begin
  HintWindow.Font := Value;
  UpdateHint;
end;

procedure THintManager.SetPosition(const Value: TPoint);
begin
  if (FPosition.X = Value.X) and (FPosition.Y = Value.Y) then exit;
  SetPositionX(Value.X);
  SetPositionY(Value.Y);
end;

function THintManager.GetPositionX: Longint;
begin
  result := FPosition.X;
end;

function THintManager.GetPositionY: Longint;
begin
  result := FPosition.Y;
end;

procedure THintManager.SetPositionX(const Value: Longint);
begin
  if FPosition.X = Value then exit;
  if Value>=0 then FPosition.X := Value else FPosition.X:=0;
  UpdateHint;
end;

procedure THintManager.SetPositionY(const Value: Longint);
begin
  if FPosition.Y = Value then exit;
  if Value>=0 then FPosition.Y := Value else FPosition.Y:=0;
  UpdateHint;
end;

procedure THintManager.Show;
begin
  HintWindow.ActivateHint(Rectangle,HintWindow.Caption);
  FTimer.Interval := FMaxShowTime;
  FTimer.Enabled := FMaxShowTime>0;
  FVisible := true;
end;

procedure THintManager.Hide;
begin
  FTimer.Enabled := false;
  HintWindow.ReleaseHandle;
  FVisible := false;
end;

procedure THintManager.SetVisible(const Value: Boolean);
begin
  FVisible := Value;
  if FVisible then Show else Hide;
end;

procedure THintManager.ShowHint;
begin
  Visible := true;
end;

procedure THintManager.HideHint;
begin
  Visible := false;
end;

function THintManager.GetRectangle: TRect;
  var i:Longint;
begin
  if (FMaxWidth<=0) or (FMaxWidth>Screen.DesktopWidth) then
    i := Screen.DesktopWidth
  else
    i := FMaxWidth;
  result := HintWindow.CalcHintRect(i,HintWindow.Caption,nil);
  result.Left := FPosition.X;
  result.Top := FPosition.Y;
  if FOrientation in [hoUpLeft, hoDownLeft] then Dec(result.Left,result.Right);
  if FOrientation in [hoUpLeft, hoUpRight] then Dec(result.Top,result.Bottom);
  Inc(result.Right,result.Left);
  Inc(result.Bottom,result.Top);
end;

procedure THintManager.SetOrientation(const Value: THintOrientation);
begin
  if FOrientation = Value then exit;
  FOrientation := Value;
  UpdateHint;
end;

procedure THintManager.UpdateHint;
begin
  if FVisible then Show;
end;

function THintManager.PositionFromControl(Control:TControl; Vertex: THintOrientation=hoUpLeft;
                                HorPercent:Integer=0; VerPercent:Integer=0): TPoint;
begin
  result := Control.ClientOrigin;
  if Vertex in [hoUpRight, hoDownRight] then Inc(result.X,Control.Width);
  if Vertex in [hoDownLeft, hoDownRight] then Inc(result.Y,Control.Height);
  if Vertex in [hoUpLeft, hoUpRight] then Dec(result.Y,4);
  Inc(result.X, trunc(HorPercent * Control.Width / 100) );
  Inc(result.Y, trunc(VerPercent * Control.Height / 100) );
end;

procedure THintManager.ShowHintFromControl(Control:TControl; Vertex: THintOrientation=hoUpLeft;
                                HorPercent:Integer=0; VerPercent:Integer=0);
begin
  Position := PositionFromControl(Control,Vertex,HorPErcent,VerPercent);
  ShowHint;
end;

function THintManager.GetOnDrawHint: TDrawHintEvent;
begin
  result := HintWindow.OnDrawHint;
end;

procedure THintManager.setOnDrawHint(const Value: TDrawHintEvent);
begin
  HintWindow.OnDrawHint := Value;
end;

procedure THintManager.SetMaxShowTime(const Value: Integer);
begin
  if FMaxShowTime = Value then exit;
  FMaxShowTime := Value;
  if Value<=0 then FTimer.Enabled := false;
end;

procedure THintManager.OnTimer(Sender: TObject);
begin
  Hide;
end;

procedure THintManager.SetMaxWidth(const Value: LongInt);
begin
  if FMaxWidth = Value then exit;
  FMaxWidth := Value;
  UpdateHint;
end;

{ THintDrawWindow }

procedure THintDrawWindow.CMFontChanged(var Message: TMessage);
begin
  Canvas.Font := Font;
  if Handle<>0 then SendMessage(Handle,CM_TEXTCHANGED,0,0);
  inherited;
end;

procedure THintDrawWindow.Paint;
begin
  if Assigned(OnDrawHint) then
    OnDrawHint(self,Canvas,Caption)
  else
    inherited;
end;

procedure Register;
begin
  RegisterComponents('DCF', [THintManager]);
end;

end.
